home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Amiga Public Domain Connection / APDC Disk #005 - Amiga Basic Programs (198x)(Amiga Public Domain Connection)(US)[WB].zip / APDC Disk #005 - Amiga Basic Programs (198x)(Amiga Public Domain Connection)(US)[WB].adf / Laser_Strike (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-03-13  |  7KB  |  202 lines
  1. DEFINT a-z:DEFSNG r,g,b
  2. DIM g(1,9,9),c(1,9,9),nh(1,5),xh(1,5),yh(1,5),dx(1,5),dy(1,5),ta(1,5),s(27,8),w1(255),w2(255)
  3. SCREEN 1,320,200,3,1:WINDOW 3,"",(0,0)-(311,186),16,1:WINDOW OUTPUT 3:COLOR 6 ,0
  4. FOR i=0 TO 255:w1(i)=RND*255-128:w2(i)=RND*255-128:NEXT
  5. RESTORE PaletteData:FOR i=0 TO 7:READ r,g,b:PALETTE i,r,g,b:NEXT
  6. PaletteData:
  7. DATA .13,0,.73,.13,0,.73,1,.73,0,.8,0,.93,.33,.87,0,.8,.2,0,.9,.9,.9,0,.73,.73
  8. RESTORE VoiceData:FOR i=0 TO 8:READ v%(i):NEXT
  9. VoiceData:
  10. DATA 110,0,150,0,22200,64,10,1,0
  11. WIDTH 40:CLS:RANDOMIZE TIMER
  12. FOR co=1 TO 7:CLS:LINE(1,1)-(7,7),co,BF:GET(1,1)-(8,8),s(0,co):NEXT
  13. CLS:LOCATE 11,14:CALL Echo("LASER STRIKE",v%()):PRINT
  14. gx(0)=24:gx(1)=192:gy=64
  15. b$="                                       "                    
  16. RESTORE ShipNames:FOR i=2 TO 5:READ s$(i):NEXT
  17. ShipNames:
  18. DATA Explorer,Fighter,Bomber,Mothership
  19. FOR i=0 TO 1
  20. PRINT "Player"+STR$(i+1);:INPUT p$(i):IF p$(i)="" THEN cp(i)=1:p$(i)="Computer"
  21. PALETTE 1,0.5,0.5,0.5
  22. NEXT:CLS:LOCATE 7,6:COLOR 1,0:PRINT"GRID 1"SPC(15)"GRID 2"
  23. GOSUB DrawGrid:LOCATE 20,1:COLOR 6,0
  24. FOR n=5 TO 2 STEP-1:l=10-LEN(s$(n))
  25. PRINT SPC(l)s$(n)SPC(13+l)s$(n):NEXT
  26.  
  27. DeploySHips:
  28.  
  29. d=0:FOR pp=0 TO 1:p=ABS(pp-1):ls(p)=5:FOR n=5 TO 2 STEP -1:er=1
  30. COLOR 6,0
  31. WHILE er=1
  32. LOCATE 1,1:PRINT p$(pp)
  33. PRINT"Deploy your "s$(n)".";
  34. FOR i=1 TO n:PUT(i*8+POS(0)*8,8),s(0,n),PSET:NEXT
  35. LOCATE 7,6:COLOR p,ABS(p-1):PRINT"GRID 1";:COLOR ABS(p-1),p:PRINT SPC(15)"GRID 2"
  36. COLOR 6,0 : LOCATE 3,1
  37. IF cp(pp)=0 THEN GOSUB Human :ELSE x=INT(RND*(10-n)):y=INT(RND*(10-n))
  38. GOSUB SelectDir
  39. WEND
  40. GOSUB ClearTop:NEXT:GOSUB DrawGrid:NEXT
  41. p=1:d=1:GOSUB ClearTop
  42. FOR i=0 TO 1:px(i)=0:py(i)=0:NEXT
  43.  
  44. MainLoop:
  45. WHILE th(p)<14:p=ABS(p-1):pp=p:WHILE INKEY$<>"":WEND
  46. LOCATE 7,6:COLOR p,ABS(p-1):PRINT"GRID 1";:COLOR ABS(p-1),p:PRINT SPC(15)"GRID 2"
  47. LOCATE 1,1:COLOR 0,1:PRINT p$(p)
  48. PRINT"Position and fire laser."
  49. IF cp(p)=0 THEN GOSUB Human :ELSE GOSUB Computer
  50. GOSUB FireLaser:GOSUB PutFigure:GOSUB ClearTop
  51. WEND
  52.  
  53. EndGame:
  54. COLOR 5,0:CLS:LOCATE 11,15:CALL Echo("GAME OVER",v%())
  55. COLOR 4:LOCATE 13,20-LEN(p$(p))/2:CALL Echo(p$(p),v%())
  56. LOCATE 14,9:CALL Echo("Has freed the galaxy!",v%())
  57. COLOR 2:LOCATE 17,12:PRINT"Play again [Y/N]"
  58. SAY TRANSLATE$("play again"),v%:c=1
  59. WHILE k$<>"Y" AND k$<>"N"
  60. k$=UCASE$(INKEY$):c=ABS(c-1)
  61. COLOR 5+c:LOCATE 11,15:PRINT"GAME OVER":FOR i=1 TO 200:NEXT
  62. LOCATE 11,1:PRINT b$:FOR i=1 TO 200:NEXT
  63. WEND
  64. IF k$="Y" THEN RUN
  65. IF k$="N" THEN CLS:END
  66.  
  67. delay:FOR i=1 TO 1500:NEXT:RETURN
  68.  
  69. ClearTop:LOCATE 1,1:COLOR,d:FOR i=1 TO 5:PRINT b$:NEXT:RETURN
  70.  
  71. PutFigure:PUT(x*8+gx(p),y*8+gy),s(0,co),PSET:pc=c(p,x,y):c(p,x,y)=co:RETURN
  72.  
  73. DrawGrid:
  74. co=7:FOR y=0 TO 9:FOR x=0 TO 9:FOR p=0 TO 1:IF c(p,x,y)<>1 THEN GOSUB PutFigure
  75. NEXT p,x,y:RETURN
  76.  
  77. CheckXY:
  78.  
  79. IF x<0 OR x>9 THEN er=1
  80. IF y<0 OR y>9 THEN er=1
  81. RETURN
  82.  
  83. FitShip:
  84. x1=x
  85. 80 x1=x1+1:IF x1<=9 THEN IF g(p,x1,y)<>1 THEN 80
  86. xp=x1-x:x1=x
  87. 90 x1=x1-1:IF x1>=0 THEN IF g(p,x1,y)<>1 THEN 90
  88. xn=x-x1:tx=xn+xp-1:y1=y
  89. 100 y1=y1+1:IF y1<=9 THEN IF g(p,x,y1)<>1 THEN 100
  90. yp=y1-y:y1=y
  91. 110 y1=y1-1:IF y1>=0 THEN IF g(p,x,y1)<>1 THEN 110
  92. yn=y-y1:ty=yn+yp-1:RETURN
  93.  
  94. Human:
  95. x=px(p):y=py(p):x1=x:y1=y:k$=""
  96. begin:
  97. WHILE MOUSE(0)<>1 : k$=INKEY$
  98. WEND:
  99. x=INT((MOUSE(3)-gx(p)+1)/8) : y=INT((MOUSE(4)-gy)/8)
  100. IF x < 0 THEN oops
  101. IF x > 9 THEN oops
  102. IF y < 0 THEN oops
  103. IF y > 9 THEN oops
  104. GOTO whew
  105. oops:
  106. LOCATE 4,1:COLOR 5:PRINT "OUT OF BOUNDS, try again:"
  107. GOSUB delay: GOSUB delay : GOSUB delay
  108. COLOR 6: LOCATE 4,1 : PRINT b$
  109. GOTO begin
  110. whew:
  111. co=pc : GOSUB PutFigure
  112. px(p)=x :  py(p)=y  :  RETURN
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121. Computer:
  122. h=0:FOR n=2 TO 5:IF nh(p,n)>0 AND nh(p,n)<n THEN sh=n:h=1
  123. NEXT:IF h=0 THEN 40
  124. x=xh(p,sh):y=yh(p,sh):IF nh(p,sh)>1 THEN 20
  125. FOR i=0 TO 3:pr(i)=0:NEXT
  126. 10 r=INT(RND*4):IF pr(r)=1 THEN 10
  127. dx(p,sh)=0:dy(p,sh)=0:er=0:pr(r)=1:GOSUB FitShip
  128. IF r=0 THEN dx(p,sh)=1:IF tx<sh OR xp<xn THEN er=1
  129. IF r=1 THEN dx(p,sh)=-1:IF tx<sh OR xn<xp THEN er=1
  130. IF r=2 THEN dy(p,sh)=1:IF ty<sh OR yp<yn THEN er=1
  131. IF r=3 THEN dy(p,sh)=-1:IF ty<sh OR yn<yp THEN er=1
  132. x=x+dx(p,sh):y=y+dy(p,sh)
  133. GOSUB CheckXY:IF er=0 THEN IF g(p,x,y)<>1 THEN 50
  134. x=x-dx(p,sh):y=y-dy(p,sh):GOTO 10
  135. 20 x=x+dx(p,sh):y=y+dy(p,sh)
  136. er=0:GOSUB CheckXY:IF er=1 THEN GOSUB 30: GOTO 20
  137. IF g(p,x,y)=1 THEN GOSUB 30:GOTO 20
  138. IF g(p,x,y)=0 THEN GOSUB 30
  139. GOTO 50
  140. 30 IF ta(p,sh)=0 THEN dx(p,sh)=-dx(p,sh):dy(p,sh)=-dy(p,sh):ta(p,sh)=1
  141. RETURN
  142. 40 x=INT(RND*10):y=INT(RND*10)
  143. IF ((x+y) AND 1)=0 THEN 40
  144. IF g(p,x,y)=1 THEN 40
  145. GOSUB FitShip:IF tx<ls(p) AND ty<ls(p) THEN 40
  146. 50 co=6:GOSUB PutFigure:RETURN
  147.  
  148. SelectDir:
  149. IF g(p,x,y)<>0 THEN GOTO 70
  150. k$=CHR$(29+INT(RND*2))
  151. IF cp(pp)=0 THEN
  152. PRINT"Horizontal [right] or vertical [down]?"
  153. k$="":WHILE k$<>CHR$(30) AND k$<>CHR$(29):k$=INKEY$:WEND
  154. END IF:er=0
  155. IF k$=CHR$(30) THEN GOTO 60
  156. IF y+n-1>9 THEN GOTO 70
  157. FOR i=y TO y+n-1:IF g(p,x,i)<>0 THEN er=1
  158. NEXT:IF er=1 THEN GOTO 70
  159. y1=y:FOR y=y1 TO y1+n-1:g(p,x,y)=n:IF cp(pp)=0 THEN co=n:GOSUB PutFigure
  160. NEXT:RETURN
  161. 60 IF x+n-1>9 THEN GOTO 70
  162. FOR i=x TO x+n-1:IF g(p,i,y)<>0 THEN er=1
  163. NEXT:IF er=1 THEN GOTO 70
  164. x1=x:FOR x=x1 TO x1+n-1:g(p,x,y)=n:IF cp(pp)=0 THEN co=n:GOSUB PutFigure
  165. NEXT:RETURN
  166. 70 er=1:IF cp(pp)=0 THEN LOCATE 4,1:COLOR 5:PRINT"INVALID CHOICE":GOSUB delay
  167. COLOR 6:co=pc:GOSUB PutFigure:GOSUB ClearTop:RETURN
  168.  
  169. FireLaser:
  170. WAVE 0,SIN:WAVE 1,SIN:k=1
  171. FOR i=250 TO 1 STEP -75:k=ABS(k-1):SOUND 660,0.5,i,k
  172. FOR j=1 TO 500:NEXT:SOUND 0,0,0,k:FOR j=1 TO 500:NEXT:NEXT
  173. n=g(p,x,y)
  174. IF n=0 THEN PRINT"MISS!":GOSUB delay:co=1:g(p,x,y)=1:RETURN
  175. IF n=1 THEN PRINT"ALREADY HIT":co=pc:GOSUB delay:RETURN
  176. co=n:PRINT"DIRECT HIT!"
  177. WAVE 0,w1:WAVE 1,w2 
  178. FOR i=255 TO 10 STEP-10:SOUND 100,0.1,i,0:SOUND 100,0.1,i,3:FOR j=1 TO RND*20:NEXT:NEXT
  179. nh(p,n)=nh(p,n)+1:th(p)=th(p)+1
  180. g(p,x,y)=1:PUT((10+23*p+nh(p,n))*8,(24-n)*8),s(0,n),PSET
  181. IF n<>nh(p,n) THEN
  182. xh(p,n)=x:yh(p,n)=y
  183. ELSE
  184. FOR i=2 TO 5:IF nh(p,i)=0 THEN ls(p)=i
  185. NEXT
  186. IF n<>4 THEN 
  187. SAY TRANSLATE$(s$(n)+" deestroyed"),v%:c=1
  188. ELSE
  189. SAY TRANSLATE$("bommer deestroyed"),v%:PRINT  s$(n)
  190. END IF
  191. FOR i=1 TO 10:c=ABS(c-1):COLOR n+(6-n)*c,c
  192. LOCATE 4,20-LEN(s$(n))/2:PRINT UCASE$(s$(n))
  193. LOCATE 5,15:PRINT"DESTROYED!":FOR j=1 TO 50:NEXT:NEXT
  194. END IF
  195. FOR i=1 TO 500:NEXT:RETURN
  196.  
  197. SUB Echo(s$,v%(1)) STATIC
  198. SAY TRANSLATE$(s$),v%:PRINT s$:END SUB
  199.  
  200.  
  201.  
  202.